home *** CD-ROM | disk | FTP | other *** search
- /************************************************************************
- * *
- * N O T I C E *
- * *
- * Copyright Abandoned, 1987, Fred Fish *
- * *
- * This previously copyrighted work has been placed into the *
- * public domain by the author (Fred Fish) and may be freely used *
- * for any purpose, private or commercial. I would appreciate *
- * it, as a courtesy, if this notice is left in all copies and *
- * derivative works. Thank you, and enjoy... *
- * *
- * The author makes no warranty of any kind with respect to this *
- * product and explicitly disclaims any implied warranties of *
- * merchantability or fitness for any particular purpose. *
- * *
- ************************************************************************
- */
-
-
- /*
- * FUNCTION
- *
- * tanh double precision hyperbolic tangent
- *
- * KEY WORDS
- *
- * tanh
- * machine independent routines
- * math libraries
- *
- * DESCRIPTION
- *
- * Returns double precision hyperbolic tangent of double precision
- * floating point number.
- *
- * USAGE
- *
- * double tanh (x)
- * double x;
- *
- * REFERENCES
- *
- * Fortran IV plus user's guide, Digital Equipment Corp. pp B-5
- *
- * RESTRICTIONS
- *
- * For precision information refer to documentation of the
- * floating point library routines called.
- *
- * PROGRAMMER
- *
- * Fred Fish
- *
- * INTERNALS
- *
- * Computes hyperbolic tangent from:
- *
- * tanh(x) = 1.0 for x > TANH_MAXARG
- * = -1.0 for x < -TANH_MAXARG
- * = sinh(x) / cosh(x) otherwise
- *
- */
-
- #if !defined (__M68881__) && !defined (sfp004)
-
- #include <stdio.h>
- #include <math.h>
- #include "pml.h"
-
- static char funcname[] = "tanh";
-
- struct exception xcpt;
-
- double tanh (x)
- double x;
- {
- register int positive;
-
- if (x > TANH_MAXARG || x < -TANH_MAXARG) {
- if (x > 0.0) {
- positive = 1;
- } else {
- positive = 0;
- }
- xcpt.type = PLOSS;
- xcpt.name = funcname;
- xcpt.arg1 = x;
- if (!matherr (&xcpt)) {
- fprintf (stderr, "%s: PLOSS error\n", funcname);
- errno = ERANGE;
- if (positive) {
- xcpt.retval = 1.0;
- } else {
- xcpt.retval = -1.0;
- }
- }
- } else {
- xcpt.retval = sinh (x) / cosh (x);
- }
- return (xcpt.retval);
- }
- #endif /* __M68881__, sfp004 */
- #ifdef sfp004
-
- __asm("
-
- comm = -6
- resp = -16
- zahl = 0
-
- "); /* end asm */
-
- #endif sfp004
- #if defined (__M68881__) || defined (sfp004)
-
- __asm(".text; .even");
-
- # ifdef ERROR_CHECK
-
- __asm("
-
- _Overflow:
- .ascii \"OVERFLOW\\0\"
- _Domain:
- .ascii \"DOMAIN\\0\"
- _Error_String:
- .ascii \"tanh: %s error\\n\\0\"
- .even
- | pml compatible tanhgent
- | m.ritzert 7.12.1991
- | ritzert@dfg.dbp.de
- |
- | /* NAN = {7fffffff,ffffffff} */
- | /* +Inf = {7ff00000,00000000} */
- | /* -Inf = {fff00000,00000000} */
- | /* MAX_D= {7fee42d1,30773b76} */
- | /* MIN_D= {ffee42d1,30773b76} */
-
- .even
- double_max:
- .long 0x7fee42d1
- .long 0x30273b76
- double_min:
- .long 0xffee42d1
- .long 0x30273b76
- NaN:
- .long 0x7fffffff
- .long 0xffffffff
- p_Inf:
- .long 0x7ff00000
- .long 0x00000000
- m_Inf:
- .long 0xfff00000
- .long 0x00000000
- ");
- #endif ERROR_CHECK
-
- __asm(".even
- .globl _tanh
- _tanh:
- "); /* end asm */
-
- #endif /* __M68881__ || sfp004 */
- #ifdef __M68881__
-
- __asm("
- ftanhd a7@(4), fp0 | tanh
- fmoved fp0,a7@- | push result
- moveml a7@+,d0-d1 | return_value
- "); /* end asm */
-
- #endif __M68881__
- #ifdef sfp004
- __asm("
- lea 0xfffa50,a0
- movew #0x5409,a0@(comm) | specify function
- cmpiw #0x8900,a0@(resp) | check
- movel a7@(4),a0@ | load arg_hi
- movel a7@(8),a0@ | load arg_low
- movew #0x7400,a0@(comm) | result to d0
- .long 0x0c688900, 0xfff067f8 | wait
- movel a0@,d0
- movel a0@,d1
- "); /* end asm */
-
- #endif sfp004
- #if defined (__M68881__) || defined (sfp004)
- # ifdef ERROR_CHECK
- __asm("
- lea double_max,a0 |
- swap d0 | exponent into lower word
- cmpw a0@(16),d0 | == NaN ?
- beq error_nan |
- swap d0 | result ok,
- rts | restore d0
- ");
- #ifndef __MSHORT__
- __asm("
- error_nan:
- moveml a0@(24),d0-d1 | result = +inf
- moveml d0-d1,a7@-
- movel #62,_errno | NAN => errno = EDOM
- pea _Domain | for printf
- ");
- #else __MSHORT__
- __asm("
- error_nan:
- moveml a0@(24),d0-d1 | result = +inf
- moveml d0-d1,a7@-
- movew #62,_errno | NAN => errno = EDOM
- pea _Domain | for printf
- ");
- #endif __MSHORT__
- __asm("
- error_exit:
- pea _Error_String |
- pea __iob+52 |
- jbsr _fprintf |
- addl #12,a7 |
- moveml a7@+,d0-d1
- rts
- ");
- # else ERROR_CHECK
-
- __asm("rts");
-
- # endif ERROR_CHECK
- #endif /* __M68881__ || sfp004 */
-